This document creates a leaflet map showing goals collected as part of the Northern Bobwhite, Grasslands and Savannas National Partnership along side data collected showing NOBO trends collected by James Martin
library(tidyverse)
library(sf)
library(leaflet)
## Warning: package 'leaflet' was built under R version 4.0.3
library(htmltools)
## Warning: package 'htmltools' was built under R version 4.0.5
library(htmlwidgets)
library(raster)
library(gstat)
## Warning: package 'gstat' was built under R version 4.0.3
library(spatial)
library(dplyr)
library(jsonlite)
## Warning: package 'jsonlite' was built under R version 4.0.5
library(ggplot2)
library(hrbrthemes)
## Warning: package 'hrbrthemes' was built under R version 4.0.5
library(ggthemes)
library(rgdal)
options(scipen=999)
##Loading Boundaries
State_Boundaries <- st_read("cb_2018_us_state_500k.kml", quiet = TRUE)
State_Boundaries_GJSON <- st_read("US_State_Boundaries.json", quiet = TRUE)
State_Boundaries_Zip <- st_read("C:/Users/sageg/Desktop/newRrepo/USDA_WLFW_NOBO/StateBoundariesZIP", quiet = T)
#loading counties
natl_priority_map<-readOGR("C:/Users/sageg/Desktop/NOBO_Boundary_Aug2021_Dissolve_ST_Draft", layer="NOBO_Boundary_Aug2021_Dissolve_ST_Draft")
##Loading GCT Data
GCT_data <- read_csv("NOBODATA_ForLeaflet_Final.csv")
##Loading RDS
bird_data <- readRDS("NOBO_route_level_trends.rds")
##Loading RDS
bird_data <- readRDS("NOBO_route_level_trends.rds")
bird_data<-as(bird_data, "Spatial") #this converts the object, bird_data, into a SpatialPointsDataFrame
# proj4string(bird_data)<-"+proj=laea +lat_0=40 +lon_0=-95 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs" ## if proj4string() is NA, you can define a projection. IT HAS TO BE THE PROJECTION THAT IT WAS SUPPOSED TO HAVE ORIGINALLY
## convert the projection
bird_dat<-spTransform(bird_data, CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO"): Discarded datum WGS_1984 in CRS definition,
## but +towgs84= values preserved
transf_natl_PA <- spTransform(natl_priority_map, CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO"): Discarded datum WGS_1984 in CRS definition,
## but +towgs84= values preserved
##Joining Boundaries and GCT Data
GCT_and_Geographies <- st_as_sf(left_join(GCT_data, State_Boundaries_Zip, by =c("STATE" ="NAME")))
## Creating Label for States
GCT_and_Geographies$label <-
paste("<b>", "<big>", GCT_and_Geographies$STATE,"</b>", "</big>",
"<br>", GCT_and_Geographies$REGION,
"<br>", "Values shown below reflect the combined value of", "<br>", "Original Program Goals and Framework Goals",
"<br>",
"<br>",
"<b> Top 3 Core Conservation Practices: </b>",
"<br>",
GCT_and_Geographies$TOP3CORE,
"<br>",
"<br>",
"<b>", "Financial Assistance:", "</b>","<br>",
"$ ", prettyNum(GCT_and_Geographies$REQFIN_FRAME,big.mark=","),
"<br>",
"<br>", "<b>", "Total CP Coverage, Acres:", "</b>",
"<br>", "Core:", prettyNum(GCT_and_Geographies$ACRE_FRAME_CORE, big.mark = ","),
"<br>", "Supplemental:", prettyNum(GCT_and_Geographies$ACRE_FRAME_SUPP, big.mark = ","),
"<br>", "Core and Supp Combined:", prettyNum(GCT_and_Geographies$ACRE_FRAME_CAS, big.mark = ","),
"<br>",
"<br>", "<b>", "Total CP Coverage, Feet:", "</b>",
"<br>", "Core:", prettyNum(GCT_and_Geographies$FT_FRAME_CORE, big.mark = ","),
"<br>", "Supplemental:", prettyNum(GCT_and_Geographies$FT_FRAME_SUPP, big.mark = ","),
"<br>", "Core and Supp Combined:", GCT_and_Geographies$FT_FRAME_CAS,
"<br>",
"<br>", "<b>", "Total CP Coverage, Number of X:", "</b>",
"<br>",GCT_and_Geographies$X_FRAME,
"<br>",
"<br>", "<b>", "Number of Written Plans:", "</b>",
"<br>",GCT_and_Geographies$WRITTEN_FRAME,
"<br>",
"<br>", "<b>", "Number of Applied Plans:", "</b>",
"<br>",GCT_and_Geographies$APPLIED_FRAME) %>%
lapply(htmltools::HTML)
# Creating Label for NOBO Trend Data
bird_dat$label <-
paste("NOBO Trend Data","<br>", "Abundance:", round(bird_dat$abund, digits=3),"<br>","Trend:", round(bird_dat$trend, digits=3),"</b>")%>%
lapply(htmltools::HTML)
# create color coded dots
bins <- seq(min(bird_dat$trend),
max(bird_dat$trend), by = .25)
# colramp<-colorRampPalette(c("red", "yellow", "blue"))
# cols<-colramp(length(bins))
pal <- colorNumeric("magma",
domain = bins,
na.color = "#00000000")
scale_fill_brewer(palette="RdYlGn")
## <ggproto object: Class ScaleDiscrete, Scale, gg>
## aesthetics: fill
## axis_order: function
## break_info: function
## break_positions: function
## breaks: waiver
## call: call
## clone: function
## dimension: function
## drop: TRUE
## expand: waiver
## get_breaks: function
## get_breaks_minor: function
## get_labels: function
## get_limits: function
## guide: legend
## is_discrete: function
## is_empty: function
## labels: waiver
## limits: NULL
## make_sec_title: function
## make_title: function
## map: function
## map_df: function
## n.breaks.cache: NULL
## na.translate: TRUE
## na.value: NA
## name: waiver
## palette: function
## palette.cache: NULL
## position: left
## range: <ggproto object: Class RangeDiscrete, Range, gg>
## range: NULL
## reset: function
## train: function
## super: <ggproto object: Class RangeDiscrete, Range, gg>
## rescale: function
## reset: function
## scale_name: brewer
## train: function
## train_df: function
## transform: function
## transform_df: function
## super: <ggproto object: Class ScaleDiscrete, Scale, gg>
# setup Leaflet
leaflet(options=leafletOptions(minZoom = 4)) %>%
addProviderTiles(providers$Stamen.Terrain) %>%
addProviderTiles("Esri.WorldImagery", group="Aerial") %>%
#create layer toggle
addLayersControl(
baseGroups = c("Map", "Aerial"),
overlayGroups = c("Points", "States", "Priority Counties"),
position = "topleft"
) %>%
#Add State Data
addPolygons(data=GCT_and_Geographies,
highlightOptions = highlightOptions(fillOpacity = 1, fillColor="cornsilk"),
weight=1,
fillColor= "orange",
color = "black",
fillOpacity=.5,
label = paste0(GCT_and_Geographies$STATE, " - ", GCT_and_Geographies$REGION),
popup=~label,
group="States",
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "11px",
direction = "auto")) %>%
# Add NOBO trend Data
addCircles(data=bird_dat,
color = ~pal(trend),
# size=bird_dat$abund,
opacity=0.8,# fillOpacity = 0.6,
label=paste0("Trend: 2002-2019: ", round(bird_dat$trend,digits=3)),
popup=~label,
group="Points") %>%
addPolygons(data=transf_natl_PA,
# popup= GCT_and_Geographies$label[GCT_and_Geographies$STATE==indiana_priority_map$State],
# color=priority$color, fillOpacity=0.8,
#label=priority$Priority,
color="Black",
fillColor = "red",
opacity = .5,
weight =1,
group="Priority Counties")%>%
#set Max Bounds
setMaxBounds(lng1=-100.791110603,
lat1= 20,
lng2= -66.96466,
lat2= 71.3577635769)
## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'
## Warning in pal(trend): Some values were outside the color scale and will be
## treated as NA
## Warning in pal(trend): Some values were outside the color scale and will be
## treated as NA